home *** CD-ROM | disk | FTP | other *** search
- # ToDo:
- #
- # - Load globs
- # - Dump *foo{IO} and *foo{FORMAT}
- # - Rewrite documentation
- # - Copy all relevant code from YAML::Syck
- # - Review YAML::Syck Changes file
- # - Make YAML a prereq for YAML-LibYAML
- # - Make loading regexp use code from YAML::Types
- # - Make glob dumping use YAML::Node
- # - Move all YAML and YAML::XS tests to YAML::Tests
- # - Make YAML and YAML::XS pass all common tests
- # - Add scalar dumping heuristics similar to YAML.pm
- #
- # Tests:
- # - Abstract all tests to YAML::Tests
- # - http://svn.ali.as/cpan/concept/cpan-yaml-tiny/
- #
- # Profiling:
- # - TonyC: sprof if I can remember the way to enable shared library profiling
- # - TonyC: LD_PROFILE, but that may not work on OS X
- # - TonyC: sample or Sampler.app on OS X, I'd guess
-
-
- package YAML::XS;
- use 5.008003;
- use strict;
- $YAML::XS::VERSION = '0.33';
- use base 'Exporter';
-
- @YAML::XS::EXPORT = qw(Load Dump);
- @YAML::XS::EXPORT_OK = qw(LoadFile DumpFile);
- %YAML::XS::EXPORT_TAGS = (
- all => [qw(Dump Load LoadFile DumpFile)],
- );
- # $YAML::XS::UseCode = 0;
- # $YAML::XS::DumpCode = 0;
- # $YAML::XS::LoadCode = 0;
-
- use YAML::XS::LibYAML qw(Load Dump);
-
- sub DumpFile {
- my $OUT;
- my $filename = shift;
- if (ref $filename eq 'GLOB') {
- $OUT = $filename;
- }
- else {
- my $mode = '>';
- if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
- ($mode, $filename) = ($1, $2);
- }
- open $OUT, $mode, $filename
- or die "Can't open '$filename' for output:\n$!";
- }
- local $/ = "\n"; # reset special to "sane"
- print $OUT YAML::XS::LibYAML::Dump(@_);
- }
-
- sub LoadFile {
- my $IN;
- my $filename = shift;
- if (ref $filename eq 'GLOB') {
- $IN = $filename;
- }
- else {
- open $IN, $filename
- or die "Can't open '$filename' for input:\n$!";
- }
- return YAML::XS::LibYAML::Load(do { local $/; <$IN> });
- }
-
- # XXX Figure out how to lazily load this module.
- # So far I've tried using the C function:
- # load_module(PERL_LOADMOD_NOIMPORT, newSVpv("B::Deparse", 0), NULL);
- # But it didn't seem to work.
- use B::Deparse;
-
- # XXX The following code should be moved from Perl to C.
- $YAML::XS::coderef2text = sub {
- my $coderef = shift;
- my $deparse = B::Deparse->new();
- my $text;
- eval {
- local $^W = 0;
- $text = $deparse->coderef2text($coderef);
- };
- if ($@) {
- warn "YAML::XS failed to dump code ref:\n$@";
- return;
- }
- $text =~ s[BEGIN \{\$\{\^WARNING_BITS\} = "UUUUUUUUUUUU\\001"\}]
- [use warnings;]g;
-
- return $text;
- };
-
- $YAML::XS::glob2hash = sub {
- my $hash = {};
- for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
- my $value = *{$_[0]}{$type};
- $value = $$value if $type eq 'SCALAR';
- if (defined $value) {
- if ($type eq 'IO') {
- my @stats = qw(device inode mode links uid gid rdev size
- atime mtime ctime blksize blocks);
- undef $value;
- $value->{stat} = {};
- map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
- $value->{fileno} = fileno(*{$_[0]});
- {
- local $^W;
- $value->{tell} = tell(*{$_[0]});
- }
- }
- $hash->{$type} = $value;
- }
- }
- return $hash;
- };
-
- use constant _QR_MAP => {
- '' => sub { qr{$_[0]} },
- x => sub { qr{$_[0]}x },
- i => sub { qr{$_[0]}i },
- s => sub { qr{$_[0]}s },
- m => sub { qr{$_[0]}m },
- ix => sub { qr{$_[0]}ix },
- sx => sub { qr{$_[0]}sx },
- mx => sub { qr{$_[0]}mx },
- si => sub { qr{$_[0]}si },
- mi => sub { qr{$_[0]}mi },
- ms => sub { qr{$_[0]}sm },
- six => sub { qr{$_[0]}six },
- mix => sub { qr{$_[0]}mix },
- msx => sub { qr{$_[0]}msx },
- msi => sub { qr{$_[0]}msi },
- msix => sub { qr{$_[0]}msix },
- };
-
- sub __qr_loader {
- if ($_[0] =~ /\A \(\? ([ixsm]*) (?:- (?:[ixsm]*))? : (.*) \) \z/x) {
- my $sub = _QR_MAP->{$1} || _QR_MAP->{''};
- &$sub($2);
- }
- else {
- qr/$_[0]/;
- }
- }
-
- 1;
-
- =encoding utf8
-
- =head1 NAME
-
- YAML::XS - Perl YAML Serialization using XS and libyaml
-
- =head1 SYNOPSIS
-
- use YAML::XS;
-
- my $yaml = Dump [ 1..4 ];
- my $array = Load $yaml;
-
- =head1 DESCRIPTION
-
- Kirill Siminov's C<libyaml> is arguably the best YAML implementation.
- The C library is written precisely to the YAML 1.1 specification. It was
- originally bound to Python and was later bound to Ruby.
-
- This module is a Perl XS binding to libyaml which offers Perl the best YAML
- support to date.
-
- This module exports the functions C<Dump> and C<Load>. These functions
- are intended to work exactly like C<YAML.pm>'s corresponding functions.
-
- =head1 SEE ALSO
-
- * YAML.pm
- * YAML::Syck
- * YAML::Tiny
-
- =head1 AUTHOR
-
- Ingy d├╢t Net <ingy@cpan.org>
-
- =head1 MAINTAINERS
-
- Yuval Kogman <nothingmuch@woobling.org>
-
- Gisle Aas <gisle@ActiveState.com>
-
- =head1 COPYRIGHT
-
- Copyright (c) 2007, 2008, 2009, 2010. Ingy d├╢t Net.
-
- This program is free software; you can redistribute it and/or modify it
- under the same terms as Perl itself.
-
- See http://www.perl.com/perl/misc/Artistic.html
-
- =cut
-